Language/OS - Multiplatform Resource Library/LANGUAGE OS.iso/yerk/mps231ss.hqx/Mops source/Module source/windowmod.txt

Text File | 1993-02-03 | 10KB | 394 lines

\ Window class.

\  May 91 mrh    Added NonScrollWind.
\    Default grow and drag limits set at grow and drag time.
\    Also fixed a number of long-standing bugs in draw:, enable:, disable:
\    etc.  New: deactivates current window.  Added PenIntoWind:.


\        ===================================

\ WINDOW is the basic window class, with no controls.
\  For windows with controls, use Window+.

\        ===================================

:class    WINDOW  super{ grafPort }

  $ 20    bytes    wind1            \ unmapped
        handle    CTLLIST            \ 1st ctl
  $ 0C    bytes    wind2            \ unmapped

        rect    CONTRECT        \ true content
        rect    GROWRECT        \ grow size rectangle
        rect    DRAGRECT        \ drag limits rect

        bool    GROWFLG            \ true if growable
        bool    DRAGFLG            \ true if draggable
        bool    ALIVE            \ true if space exists
        bool    SCROLLFLG        \ true if scrollable

        x-addr    IDLE            \ idle handler
        x-addr    DEACT            \ deactivate event handler

        x-addr    CONTENT            \ content handler
        x-addr    DRAW            \ draw handler
        x-addr    ENACT            \ activate event handler
        x-addr    CLOSE            \ close handler

        int        RESID            \ resource id

private

:m SETLIMITS:    \ Sets GrowRect and DragRect to reasonable default values
                \ according to the current screen size at the time the grow
                \ or drag is done.  Programs such as SteppingOut can change
                \ the screen size while a window is open!

    screenbits  put: dragRect
    40 40 getBot: dragRect  put: growRect
    4 4 inset: dragRect  ;m

:m ?SETFPRECT:    \ Sets fPrect if scrollFlg is true.  fPrect is needed by
                \ the nucleus for scrolling fWind, before proper window
                \ handling is loaded.  But it can be used for scrolling
                \ text in any other window as well, if scrolling is enabled
                \ for that window.

    get: scrollFlg IF  get: contRect  put: fPrect  THEN  ;m

:m ?DISABLE_ACTW:    \ Deactivates the currently active window before a New:
                    \ or GetNew: call, if there is a currently active Mops
                    \ window.
    actW  0EXIT
    disable: actW  0 -> actW  ;m

:m InitNewWindow:
    setContRect: [self]
    set: self  initfont  true  put: alive
    cls  ;m

:m PenIntoWind:    \ Moves the GrafPort pen back into the window area if
                \ necessary, after the window has been resized.
                \ Actually at the moment we only worry about the vertical
                \ direction.
    @xy bottom min  gotoxy  ;m

public

:m SETCONTRECT:    \ Sets ContRect to the viewing area.  Must be public since
                \ we late-bind to it, and it gets called from ObjInit anyway.

    get: portRect  get: growFlg
    IF  swap 15 -  swap  15 -  THEN   put: contRect
    ?setfPrect: self  ;m

:m CLOSE:
    get: alive  0exit
    ^base  call CloseWindow
    clear: alive   exec: close  ;m

:m RELEASE:    close: [self]  ;m    \ Standard destructor - same as close.

:m SET:        \ Makes this wind the current GrafPort.  It used
            \ to call setContRect: but there's really no need.
    set: super
    ?setfPrect: self  ;m

:m UPDATE:    \ Generates an update event for the window with its
            \  entire port rectangle as the update region.
    pushPort  set: self
    getRect: self  put: tempRect  update: tempRect
    popPort  ;m


:m NEW: { bndsRect tAddr tLen procID vis goAway \ s255 -- }

  \ Defines a new window on the heap with the specified features.
  \ Not resource based.

    get: alive  ?EXIT                    \ Out if already alive
    ?disable_actW: self
    tAddr tLen  str255  -> s255
    0  ^base  bndsrect  s255  vis Tbool
    procID makeint
    inFront  goAway Tbool  0
    call NewWindow  drop
    initNewWindow: self  ;m


:m GETNEW:        \ ( resid -- )   Resource based new window.

    get: alive  IF  drop  EXIT  THEN    \ Out if already alive
    ?disable_actW: self
    dup  put: resid  0 swap makeint ^base  0
    call GetNewWindow  drop
    initNewWindow: self  ;m


:m GETRECT:        \ ( -- l t r b )  Returns the port rect
    get: portRect  ;m

:m GETVSRECT:    \ ( l t r b -- l' t' r' b' )
                \ Returns the default vert. scroll bar rect.
    get: portRect  >vrect  ;m

:m GETHSRECT:    \ ( l t r b -- l' t' r' b' )
                \ Returns the default horiz. scroll bar rect.
    get: portRect  >hrect  ;m


\ The DRAW: method is called, late-bound, whenever a window is updated.
\ The implementation must begin with a BeginUpdate call and end with an
\ EndUpdate call.  We use the CallFirst/CallLast mechanism to ensure this,
\ and also to draw the grow icon if this is a growable window.  This means
\ that any redefinition of DRAW: in a subclass should not call DRAW: super,
\ since this would lead to BeginUpdate and EndUpdate being called more than
\ once.  So we define another method (DRAW): to do the actual work for DRAW:,
\ and subclasses which need their own versions of DRAW: may call (DRAW):
\ freely.

private

:m (DRAW):        \ Does the main work for DRAW:.
    savePort  @xy  set: self        \ Save port and pen posn, reset to this
                                    \  window
    exec: draw                        \ Call user draw routine
    restport gotoxy  ;m                \ Restore pen posn, restore original port


:m SETUP_DRAW:
    get: fPrect                        \ Save fPrect as it might get changed
    ^base  call BeginUpdate  ;m

:m WINDUP_DRAW:
    get: growFlg
    IF    @xy
        ^base  call DrawGrowIcon
        gotoxy
    THEN
    ^base  call EndUpdate
    put: fPrect  ;m                    \ Restore fPrect


callFirst    setup_draw:
callLast    windup_draw:

public

:m DRAW:    (draw): self  ;m


:m SELECT:        \ Makes this the front window.
    ^base  call SelectWindow
    ?setfPrect: self  ;m


\ The idle: method is called for the frontmost window, whenever a null
\ event occurs.  NULL-EVT is the normal word which sends idle:.  In
\ subclasses we redefine this method to do things like calling TEidle,
\ which have to be done periodically.  The Idle handler is also called,
\ which allows a window-specific action to be taken.  In the class Window
\ itself, this is all we do.

:m IDLE:        exec: idle  ;m

:m SETIDLE:        put: idle  ;m


:m ENABLE:        \ Handles an activate event.
    set: self
    get: growFlg  IF  @xy  ^base  call DrawGrowIcon  gotoxy  THEN
    exec: enact  ;m

:m DISABLE:        \ Handles a deactivate event.
    get: growFlg
    IF                                    \ We need to erase the grow icon
        @xy  get: tempRect                \ Save things
        getRect: self  put: tempRect
        getBotX: tempRect  14 -  putTopX: tempRect
        getBotY: tempRect  14 -  putTopY: tempRect
        clear: tempRect
        put: tempRect  gotoxy            \ Restore
    THEN
    exec: deact  ;m


:m ACTIONS:        \ ( close enact draw cont 4 -- )
                \ Sets up window event handler words.  We require
                \ an xt count as this is normal for actions: methods.
    4 ?#xts
    put: content  put: draw  put: enact  put: close  ;m


:m SETACT:    \ ( enact deact -- )  Sets just the activate/deactivate
            \ event handlers
    put: deact  put: enact  ;m


:m SETDRAW:        \ ( xt -- )  Sets the draw handler
    put: draw  ;m


:m ACTIVE:    \ ( -- b )  Is this window active ?
    0  call FrontWindow  ^base  =  ;m


:m ALIVE:    \ ( -- b )  Is this window alive?
    get: alive  ;m


:m DRAG:    \ Handles a drag region click
    setLimits: self                    \ Omit in subclasses which need
                                    \  custom drag limits
    get: dragFlg  0exit
    ^base  whrFEv  addr: dragRect
    call DragWindow  ;m

private

\ Some housekeeping routines for Size: and Zoom:

:m ClrOldBars:
    getVSrect: self 16 +  put: tempRect
    clear: tempRect  update: tempRect    \ Including the grow box
    getHSrect: self  put: tempRect
    clear: tempRect  update: temprect  ;m

:m FixNewBars:
    ClrOldBars: self                    \ Yes, the code's the same so far!!
    addr: portRect  call ClipRect
    setContRect: [self]
    penIntoWind: self  ;m

public

:m SIZE:    \ ( w h -- )  Resizes window and accumulates update regions.
    pack  ^base  swap  true makeint
    ClrOldBars: self
    call SizeWindow
    FixNewBars: self  ;m

:m SETSIZE:    size: self  ;m    \ For naming consistency with Rects and
                            \  Views.


:m MOVE:    \ ( x y -- )  Moves the window.
    pack  ^base  swap  w 0
    call MoveWindow  ;m


:m CENTER:  { \ sw sh pw ph -- }
        \ Centers the window on the screen.
        \ Yeah, I know, here in Oz we spell this "centre", but we Ozzies
        \ are more flexible than the Yanks, so we'll magnanimously do it
        \ their way, not ours.

    screenbits  -> sh  -> sw  2drop
    size: portRect  -> ph  -> pw
    sw pw - 2/  sh ph - 2/  move: self  ;m


:m ZOOM:  { part -- }
    word0  ^base  whrFEv
    part makeint  call TrackBox  i->l
    IF    getRect: self  put: tempRect  tempRect  call EraseRect
        ^base  part makeint  word0  call ZoomWindow
        FixNewBars: self
    THEN  ;m


:m GROW:        \ Handles a mouse-down in the grow box.
    get: growFlg
    IF    setLimits: self                    \ Omit in subclasses which need
                                        \  custom grow limits
        0 ^base  whrFEv  addr: growrect
        call GrowWindow  ?dup
        IF    unpack  size: self  draw: self
            penIntoWind: self
        THEN
    THEN
    ^base  call SelectWindow
    update: self  ;m


:m CONTENT:        \ Handles a content click.
    active: self
    IF        exec: content
    ELSE    select: self
    THEN  ;m


:m TITLE:    \ ( addr len -- )  Sets the title of the window.
    str255  ^base  swap  call SetWTitle  ;m

:m NAME:  ( addr len -- )    title: self  ;m        \ An alias for TITLE:.


:m GETNAME:    \ ( -- addr len )  Returns name of window.
    ^base  buf255  call GetWTitle
    buf255 count  ;m


:m MAXX:    \ ( -- x )  Returns the x coordinate value corresponding to
            \  the window being moved to the right of the screen.
    screenbits drop nip nip
    size: portRect  drop  -  ;m


:m MAXY:    \ ( -- y )
    screenbits nip nip nip
    size: portRect  nip  -  ;m

\            =================

:m KEY:        \ ( c -- )  May be used in subclasses to do something with
            \  typed keys.  Here, we just drop it.
    drop  ;m


:m SHOW:    ^base  call ShowWindow  ;m

:m HIDE:    ^base  call HideWindow  ;m


:m SETGROW:    \ ( l t r b  T  |  F -- )  Sets grow limits, if boolean is true.

    \ Note: in class Window itself, we IGNORE these grow limits and
    \  use a default value based on the size of the screen at the time
    \  the grow is actually done.

    dup  put: growFlg
    if  put: growrect  then  ;m

:m SETDRAG:    \ ( l t r b  T  |  F -- )  Sets drag limits.

    \ Note: in class Window itself, we IGNORE these drag limits and
    \  use a default value based on the size of the screen at the time
    \  the drag is actually done.

    dup  put: dragFlg
    if  put: dragRect  then  ;m

:m SETSCROLL:    \ ( b -- )
    put: scrollFlg  ;m


:m CLASSINIT:
    xts{ null null null null }  actions: self
    ['] null  dup  put: idle  put: deact
    true  put: scrollFlg  true  put: dragFlg  ;m


:m MARKALIVE:    \ A special method really intended just to allow us to
                \ mark fWind alive on startup.
    true  put: alive   ;m


:m TEST:        \ Fires up a test window.
    100 100 300 200 put: tempRect
    screenbits true setGrow: self
    tempRect  " Test"  docWind  true true  new: self  ;m

;class